rm(list = ls())
setwd("~/Projects/news_tweets")
## --- Load Packages --- ##
library(rtweet)
library(dplyr)
library(ggplot2)
library(rvest)
library(tidyr)
library(wordcloud2)
library(igraph)
library(ggraph)
library(stringr)
library(tm)
library(tidytext)
library(stringi)
library(lubridate)
## --- Set Stylings --- ###
knitr::opts_chunk$set(message=FALSE, warning=FALSE)
theme_set(
theme_bw(base_size = 14) +
theme(
plot.title = element_text(face = "bold", size = 14,
margin = margin(0, 0, 4, 0, "pt")),
plot.subtitle = element_text(size = 12),
plot.caption = element_text(size = 6, hjust = 0),
axis.title = element_text(size = 10),
panel.border = element_blank()
)
)
## --- Global Variables --- ##
# Define Color
Mycol <- RColorBrewer::brewer.pal(8, "Dark2")
# Define http pattern
http <- paste("http.*","https.*", sep = "|")
# Define Stopwords
stopwords <- data_frame(
word = stopwords("german")
) %>% rbind(
data_frame(word = c("t.co","via","mal","dass","mehr", "amp","https",
"beim", "ab","sollen","ganz","sagt",
"schon","rt","gibt", "ja", "natürlich"))
)Deutschsprachige Tweets die den Hashtag “#GERSWE” beinhalten. Die Tweets wurden mit Hilfe des R Packetes rtweet über die REST API ausgelesen. Der gesamte Code ist hier einzusehen.
Folgende Variablen sind in unserem Datensatz vorhanden.
load("../../data/germex.Rda")
attr(rt$created_at, "tzone") <- "Europe/Berlin"
start <- as.POSIXct("2018-06-17 16:00", tz = "Europe/Berlin")
end <- start + minutes(220)
gamestart <- as.POSIXct("2018-06-17 17:00", tz = "Europe/Berlin")
gameend <- gamestart + minutes(112)
rt_small <- rt %>%
# mutate(created_at = as.POSIXct(created_at + hours(2))) %>%
filter(created_at >= start) %>%
filter(created_at <= end) rt_small %>%
ts_plot("1 minute",
color = Mycol[3]) +
geom_vline(xintercept = gamestart, color=Mycol[1], linetype = 2) +
geom_vline(xintercept = gameend, color=Mycol[1], linetype = 2) +
theme(plot.title = element_text(face = "bold"),
axis.text.x = element_blank()) +
labs(
x = NULL, y = NULL,
title = "Tweets zum Spiel Deutschland - Mexiko",
subtitle = paste("Zeitraum:",min(rt$created_at),"bis",max(rt$created_at))
) Welche Tweets wurden am häufigsten geteilt? Die top 10 sind:
rt_small %>%
filter(is_retweet == FALSE ) %>%
dplyr::select(screen_name, text, retweet_count) %>%
group_by(screen_name, text) %>%
summarise(retweet_count = sum(retweet_count)) %>%
arrange(desc(retweet_count)) %>%
.[1:10,] %>%
#knitr::kable(align = "l")
htmlTable::htmlTable(align="l")| screen_name | text | retweet_count | |
|---|---|---|---|
| 1 | DFB_Team | Schluss! #DieMannschaft verliert den WM-Auftakt gegen Mexiko. #GERMEX 0-1 #ZSMMN https://t.co/wE73FNLBrv | 1356 |
| 2 | ThatRexGuy | Joachim Löw when literally anything happens. #GERMEX #WorldCup https://t.co/5e0xQ9Q3Yy | 1172 |
| 3 | KuehniKev | Sportminister ist in #Deutschland übrigens Horst Seehofer. 🤷🏼♂️ #GERMEX | 906 |
| 4 | DerWachsame | Wir haben ein Fußballspiel verloren, das ist traurig, aber nicht schlimm. Morgen wird vielleicht ein durchgeknallter Innenminister im Alleingang die Grenzen schließen und die Regierung sprengen. DAS ist schlimm. #GERMEX | 801 |
| 5 | ghensel | Mal im Ernst. Rausfliegen in der Vorrunde passt doch bombe zu unserer masochistischen Gefühlslage gerade. Ich sehe schon die Talkshow-Themen vor mir: „Deutsches WM-Aus. Welche Rolle spielt der Islam?“ #GERMEX | 499 |
| 6 | DFB_Team | Seid ihr bereit für #GERMEX 🇩🇪🇲🇽? #ZSMMN #WM2018 #GERMEX https://t.co/POxvqBKDBj | 491 |
| 7 | DFB_Team | Auf geht’s, Männer!!! 🇩🇪🇲🇽 #ZSMMN #WM2018 #GERMEX 0-0 https://t.co/l13goZrece | 470 |
| 8 | DFB_Team | Halbzeit. Mund abputzen. Da geht noch was, Männer! #GERMEX 0-1 #DieMannschaft #ZSMMN https://t.co/0ZJu1R64iL | 443 |
| 9 | OomenBerlin |
Seit wir Nazis im Bundestag haben hat die #Nationalmannschaft noch kein WM-Spiel gewonnen. Denkt mal drüber nach. #GERMEX #WM2018 |
440 |
| 10 | FCBayern |
🇩🇪 Kopf hoch, Männer! #WeiterImmerWeiter #GERMEX #DieMannschaft #WM2018 https://t.co/CLHAah2jJo |
431 |
rt_clean <- rt_small %>%
# First, remove http elements manually
mutate(stripped_text = gsub(http,"", text)) %>%
mutate(stripped_text = gsub("germex","", text, ignore.case = T))
rt_tidy_words <- rt_clean %>%
# Second, remove punctuation, convert to lowercase, add id for each tweet!
dplyr::select(stripped_text) %>%
unnest_tokens(word, stripped_text) %>%
# Third, remove stop words from your list of words
anti_join(stopwords) %>%
# Count Word occurences in a tweet
count(word, sort = TRUE)
rt_tidy_words %>%
wordcloud2(size = 3,
color = "random-light", backgroundColor = "grey")word_network(rt_clean)SentimentWortschatz, or SentiWS for short, is a publicly available German-language resource for sentiment analysis, opinion mining etc. It lists positive and negative polarity bearing words weighted within the interval of [-1; 1] plus their part of speech tag, and if applicable, their inflections. The current version of SentiWS (v1.8b) contains 1,650 positive and 1,818 negative words, which sum up to 15,649 positive and 15,632 negative word forms incl. their inflections, respectively. It not only contains adjectives and adverbs explicitly expressing a sentiment, but also nouns and verbs implicitly containing one.
sent <- c(
# positive Wörter
readLines("../../dict/SentiWS_v1.8c_Negative.txt",
encoding = "UTF-8"),
# negative Wörter
readLines("../../dict/SentiWS_v1.8c_Positive.txt",
encoding = "UTF-8")
) %>% lapply(function(x) {
# Extrahieren der einzelnen Spalten
res <- strsplit(x, "\t", fixed = TRUE)[[1]]
return(data.frame(words = res[1], value = res[2],
stringsAsFactors = FALSE))
}) %>%
bind_rows %>%
mutate(word = gsub("\\|.*", "", words) %>% tolower,
value = as.numeric(value)) %>%
# manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
group_by(word) %>% summarise(value = mean(value)) %>% ungroupsentDF <- rt_clean %>%
# Second, remove punctuation, convert to lowercase, add id for each tweet!
unnest_tokens(word, stripped_text) %>%
left_join(., sent, by="word") %>%
mutate(value = as.numeric(value)) %>%
#filter(!is.na(value)) %>%
mutate(negative = ifelse(value < 0, value, NA),
positive = ifelse(value > 0, value, NA),
negative_d = ifelse(value < 0, 1, 0),
positive_d = ifelse(value > 0, 1, 0)) sentDF.grouped <- sentDF %>%
group_by(status_id) %>%
summarise(mean_value = mean(value, na.rm = T),
sum_value = sum(value, na.rm = T),
positive = sum(positive, na.rm = T),
negative = sum(negative, na.rm = T)) %>%
left_join(., rt_small %>% dplyr::select(status_id, screen_name, text, created_at),
by = "status_id") %>%
filter(!is.na(mean_value))
sentDF.grouped %>%
arrange(desc(mean_value)) %>%
select(screen_name, text, mean_value, created_at) %>%
.[1:10,] %>%
htmlTable::htmlTable(align="l")| screen_name | text | mean_value | created_at | |
|---|---|---|---|---|
| 1 | Hessenfriese | @BILD Ist uns fast gelungen….. #GERMEX #WM2018 https://t.co/quDq0wTnMX | 1 | 2018-06-17 17:01:12 |
| 2 | Mastermind_09 | Draxler und Reus bislang ungefähr mit gleich vielen gelungen Ballaktionen. #GERMEX | 1 | 2018-06-17 17:22:02 |
| 3 | GmachtZumTxtn | Noch nie ist es einer Mannschaft gelungen seinen eigenen Linksverteidiger so aus dem Spiel zu nehmen #GERMEX | 1 | 2018-06-17 18:37:26 |
| 4 | nerdfromaustria | Der Sonntag wäre perfekt, wenn Deutschland eins auf die Nase kriegt… Ganz neutral gesprochen ;) #GERMEX #WM2018 | 0.7299 | 2018-06-17 16:12:47 |
| 5 | DerFilmer | That feel wenn der @BR24 Radiokommentar perfekt synchron zum @BBCSport Fernsehbild ist. #GERMEX #WM2018 | 0.7299 | 2018-06-17 17:11:25 |
| 6 | mir70 | Kimmich passt vom Sympathiefaktor perfekt zum FC Bayern … #GERMEX | 0.7299 | 2018-06-17 17:26:16 |
| 7 | nerow1909 | @Endi_AJ Wer gerade mal seinen lamborghini ausfahren will, kann das gerade perfekt tun. Auch in der kölner innenstadt. #germex | 0.7299 | 2018-06-17 17:31:51 |
| 8 | Sarpei007 | Naja. Die Taktik von Mex ist halt perfekt gegen die immergleiche Aufstellung/Taktik von uns. #GERMEX | 0.7299 | 2018-06-17 17:46:21 |
| 9 | allo_morph | Ich nutze auch perfekt die Räume. Im Schlafzimmer schlafe ich, im Wohnzimmer wohne ich, im Badezimmer dusche ich…och Menno! #GERMEX | 0.7299 | 2018-06-17 17:54:25 |
| 10 | hassanscorner | Man muss aber auch sagen, dass der Testspielgegner Saudi-Arabien die Mexikaner perfekt simuliert hat. #GERMEX | 0.7299 | 2018-06-17 17:54:43 |
sentDF.grouped %>%
arrange(mean_value) %>%
select(screen_name, text, mean_value, created_at) %>%
.[1:10,] %>%
htmlTable::htmlTable(align="l")| screen_name | text | mean_value | created_at | |
|---|---|---|---|---|
| 1 | DieMone37 | Neuer wird nicht in die Gefahr kommen einzuschlafen. #WM2018 #GERMEX | -1 | 2018-06-17 17:02:47 |
| 2 | hyouhakuhunter |
Deine Meinungsfreiheit ist in Gefahr! @fckart13 #FCKArt13 #GERMEX #WM2018 https://t.co/h8XhRv1Adu |
-1 | 2018-06-17 17:04:02 |
| 3 | sirxwastaken |
Das Internet ist in Gefahr und ihr habt nur Augen für einen Ball. Schaut wenigstens in der Halbzeit mal vorbei und informiert euch! #GERMEX #fckart13 #WM2018 #ger #mex #DieMannschaft |
-1 | 2018-06-17 17:04:22 |
| 4 | sportwetten_de |
|
-1 | 2018-06-17 17:10:31 |
| 5 | Baumbart4Z0 | Das freie Internet ist in Gefahr! #WM2018 #FCKArt13 #GERMEX https://t.co/lmKRfYI6bK | -1 | 2018-06-17 17:13:00 |
| 6 | anjaSeeBR |
Am 20/21.06 stimmt das EUparlament über Artikel 13 ab. Memes, Videos, Remixe, Parodien, Zitate sind in Gefahr #Meinungsfreiheit
Informier dich: https://t.co/KhlVEENOXh #GERMEX #WM2018 #savetheinternet #FCKArt13 #SaveOurInternet |
-1 | 2018-06-17 17:20:59 |
| 7 | Winkendekatze |
SCHAUT NICHT WEG! Das Internet ist in Gefahr! WM2018GERMEX#FCKart13 https://t.co/SLDh8eSEav |
-1 | 2018-06-17 17:22:28 |
| 8 | Jan_04 | Teilweise vogelwild - auf beiden Seiten. An sich mal ein ganz angenehmer Kontrast zum kontrollierten Fußball in der Bundesliga. Birgt aber die Gefahr, dass beim Abpfiff 80 Millionen Deutsche Boatengs Haarfarbe haben. #GERMEX #WM2018 | -1 | 2018-06-17 17:23:29 |
| 9 | marcelbuslay | Am 20. Juni 2018 wird über Artikel 13 abgestimmt. Helft mit das Zensurgesetzt zu verhindern bevor es zu spät ist. Informiere dich jetzt: https://t.co/JeRueO11zn Deine Meinungsfreiheit ist in Gefahr! #FCKArt13 #savetheinternet #saveyourinternet #GERMEX https://t.co/7a1DQSsj6h | -1 | 2018-06-17 17:25:20 |
| 10 | Kwn69943344 |
Das Internet ist in Gefahr! Informier dich! #WM2018 #GERMEX #FCKart13 https://t.co/zmDr4x4lxM https://t.co/6wbQTu4ybH |
-1 | 2018-06-17 17:28:54 |
sentDF.grouped %>%
mutate(time = as.POSIXct(substr(created_at,1,16))) %>%
group_by(time) %>%
summarise(mean_value = mean(mean_value)) %>%
ggplot() +
geom_line(aes(time, mean_value),
color = Mycol[3]) +
geom_vline(xintercept = gamestart, color = Mycol[2], linetype = 2) +
geom_vline(xintercept = gameend, color = Mycol[2], linetype = 2) +
labs(y = "", x="", title = "Durchschnittlicher Sentiment Wert")